home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjag86.arc / GLABEL.BAS < prev    next >
BASIC Source File  |  1986-04-23  |  4KB  |  108 lines
  1. 10 SCREEN 2:KEY OFF:CLS
  2. 20 REM
  3. 30 REM   DEMONSTRATE VERTICAL RESOLUTION
  4. 40 REM
  5. 50 X=0
  6. 60 FOR Y = 7 TO 20
  7. 70 L$=CHR$(Y+58)
  8. 80 GOSUB 400
  9. 90 X=X+8
  10. 100 NEXT Y
  11. 110 REM
  12. 120 REM   DEMONSTRATE HORIZONTAL RESOLUTION
  13. 130 REM
  14. 140 Y = 60
  15. 150 FOR X = 65 TO 75
  16. 160 L$=CHR$(X):GOSUB 400
  17. 170 Y = Y + 8
  18. 180 NEXT X
  19. 190 REM
  20. 200 REM   DEMONSTRATE LARGE LETTERS
  21. 210 REM
  22. 220 Y=80
  23. 230 A$="BIG LETTERS"
  24. 240 FOR I = 1 TO LEN(A$)
  25. 250 X = 150+I*16
  26. 260 L$=MID$(A$,I,1)
  27. 270 GOSUB 690
  28. 280 NEXT I
  29. 290 REM
  30. 300 REM   DEMONSTRATE 90 DEGREE ROTATION
  31. 310 REM
  32. 320 A$="90 DEGREE ROTATION"
  33. 330 X = 400
  34. 340 FOR I = 1 TO LEN(A$)
  35. 350 Y = 200-I*8
  36. 360 L$=MID$(A$,I,1)
  37. 370 GOSUB 870
  38. 380 NEXT I
  39. 390 LOCATE 20,1:STOP
  40. 400 REM
  41. 410 REM   SUBROUTINE PRINTS A LETTER L$ WHOSE LOWER LEFT-HAND CORNER
  42. 420 REM   WILL BE LOCATED AT (X,Y).
  43. 430 REM
  44. 440 IF ASC(L$) > 127 THEN RETURN
  45. 450 XX = X MOD 640:IF XX < 0 THEN XX = XX + 640 'MAKE 0 <= XX <= 639
  46. 460 REM
  47. 470 REM   UNLESS (X MOD 8) = 0, PARTS OF THE LETTER WILL BE IN TWO
  48. 480 REM   DIFFERENT COLUMNS.
  49. 490 REM
  50. 500 SHIFT = 2^(8-(XX MOD 8))                      'USED TO SHIFT BITS
  51. 510 LL = INT(XX/8)                                '1ST COLUMN
  52. 520 NN = (LL+1) MOD 80                            '2ND COLUMN
  53. 530 FOR II=Y-7 TO Y                               'ROW LOOP
  54. 540 YY = II MOD 200:IF YY < 0 THEN YY = YY + 200  'MAKE 0 <= YY <= 100
  55. 550 DEF SEG = &HF000                              'SEGMENT OF ROM
  56. 560 REM
  57. 570 REM  GET A BYTE REPRESENTING ONE OF THE EIGHT ROWS OF DOTS THAT
  58. 580 REM  MAKE UP THE CHARACTER.  SHIFT THE VALUE SO THAT THE BITS
  59. 590 REM  THAT GO IN THE TWO COLUMNS ARE SEPARATED INTO SEPARATE BYTES
  60. 600 REM
  61. 610 KK = PEEK(&HFA6E+ASC(L$)*8+II-Y+7)*SHIFT
  62. 620 DEF SEG = &HB800                              'SEGMENT FOR VIDEO
  63. 625 REM  OFFSET FOR EVEN/ODD ROWS:
  64. 630 IF YY MOD 2 = 0 THEN DISP=0 ELSE DISP = &H2000 
  65. 640 MM = INT(YY/2)*80                             'OFFSET TO ROW
  66. 645 REM  SET BITS IN 1ST COLUMN:
  67. 650 POKE DISP+MM+LL,PEEK(DISP+MM+LL) OR INT(KK/256)  
  68. 655 REM  SET BITS IN 2ND COLUMN:
  69. 660 POKE DISP+MM+NN,PEEK(DISP+MM+NN) OR (KK-INT(KK/256)*256) 
  70. 670 NEXT II
  71. 680 RETURN
  72. 690 REM
  73. 700 REM   SUBROUTINE PRINTS A DOUBLE-WIDTH CHARACTER L$ WHOSE LOWER
  74. 710 REM   LEFT-HAND CORNER IS (X,Y)
  75. 720 REM
  76. 730 IF ASC(L$) > 127 THEN RETURN
  77. 740 DEF SEG =&HF000                               'SEGMENT OF ROM
  78. 750 FOR II = Y-7 TO Y                             'ROW LOOP
  79. 760 XX = X MOD 640:IF XX < 0 THEN XX = XX + 640   'MAKE 0<= XX <= 639
  80. 770 YY = II MOD 200:IF YY < 0 THEN YY=YY+200      'MAKE 0<= YY <= 199
  81. 780 KK = PEEK(&HFA6E+ASC(L$)*8+II-Y+7)   'GET PATTERN FOR A ROW
  82. 790 FOR LL=1 TO 8                        'LOOK AT BITS IN THE PATTERN
  83. 800 MM = KK MOD 2                        'GET LAST BIT
  84. 810 NN=XX+16-2*LL
  85. 815 REM MAKE 2 DOTS
  86. 820 IF MM <> 0 THEN PSET(NN MOD 640,YY):PSET((NN+1) MOD 640,YY) 
  87. 830 KK = INT(KK/2)                       'SHIFT BITS RIGHT
  88. 840 NEXT LL
  89. 850 NEXT II
  90. 860 RETURN
  91. 870 REM
  92. 880 REM   SUBROUTINE PRINTS A CHARACTER L$ WHICH HAS BEEN ROTATED
  93. 890 REM   90 DEGREES AROUND ITS LOWER LEFT-HAND CORNER (X,Y).
  94. 900 REM
  95. 910 IF ASC(L$) > 127 THEN RETURN
  96. 920 DEF SEG =&HF000                  'ROMS SEGMENT
  97. 930 FOR II = 1 TO 8                  'ROW LOOP
  98. 940 KK = PEEK(&HFA6E+ASC(L$)*8+II-1) 'GET PATTERN FOR A ROW
  99. 950 FOR LL=1 TO 8                    'COLUMN LOOP
  100. 960 MM = KK MOD 2                    'GET LAST BIT
  101. 970 NN=(X-16+2*II-1) MOD 640:IF NN < 0 THEN NN=NN+640  'GET X COOR.
  102. 980 YY = (Y-8+LL) MOD 200:IF YY < 0 THEN YY = YY + 200 'GET Y COOR.
  103. 990 IF MM <> 0 THEN PSET(NN,YY):PSET(NN+1,YY)          'MAKE TWO DOTS
  104. 1000 KK = INT(KK/2)                   'SHIFT BITS RIGHT
  105. 1010 NEXT LL
  106. 1020 NEXT II
  107. 1030 RETURN
  108.